This forum is closed to new posts and
responses. Individual names altered for privacy purposes. The information contained in this website is provided for informational purposes only and should not be construed as a forum for customer support requests. Any customer support requests should be directed to the official HCL customer support channels below:
Dim s As New NotesSession
Dim db As NotesDatabase
Dim coll As NotesDocumentCollection
Dim doc As NotesDocument
Dim ws As New NotesUIWorkspace
Set db = s.CurrentDatabase
Set coll = db.UnprocessedDocuments
Dim frm As String
Dim nam As NotesName
Dim fileNum As Integer
Dim pathBase As String
pathBase=ws.Prompt (PROMPT_OKCANCELEDIT, "Path in which eMails will be extracted", "Enter Path/Folder name(The Folder should exist) i.e. C:\Temp\", "C:\Temp\")
If Len(pathBase)<1 Then
Exit Sub
End If
For i = 1 To coll.Count
Set doc = coll.GetNthDocument( i )
filenames=Evaluate("@AttachmentNames",doc)
numberoffiles=Evaluate("@Attachments", doc)
'To extract Lotus Notes user name
Set nam=New Notesname(doc.GetItemValue("From")(0))
frm=nam.Common
If Instr(frm,Chr(34)) Then 'Check for " in the name, specially in single word name
frm=Mid(frm,2,Len(frm)-2)
End If
'To suppress duplicate folder
temp=doc.PostedDate(0)
datetime=Cstr(Day(temp))+Cstr(Month(temp))+Cstr(Year(temp))+Cstr(Hour(temp))+Cstr(Minute(temp))+Cstr(Second(temp))
temp=fullpath
fullpath=pathBase+ frm+" "+datetime
If Strcompare(fullpath,temp) Then
Mkdir fullpath
End If
If numberoffiles(0)>0 Then
For filecounter=0 To numberoffiles(0)-1
Print filenames(filecounter)
Set object = doc.GetAttachment( filenames(filecounter) )
If ( object.Type = EMBED_ATTACHMENT ) Then
fileCount = fileCount + 1
'Generate email text
fileNum% = Freefile()
Open fullpath & "\"& "eMail.txt" For Append As fileNum%
Set rtitem = doc.GetFirstItem( "Body" )
If ( rtitem.Type = RICHTEXT ) Then
plainText = rtitem.GetFormattedText( False, 0 )
End If
' write the formatted text to the file
Print #fileNum%, "From: "+ doc.From(0)
Print #fileNum%, "Date: " +Cstr(doc.PostedDate(0))
Print #fileNum%,"Message: "+plainText
' close the file
Close #fileNum
Next
Messagebox "Selected eMail(s) & attachments are been extracted in " & pathBase & " by NameDateTime folder format"
Exit Sub
Errhandle:
' Use the Err function to return the error number and
' the Error$ function to return the error message.
Messagebox "Error" & Str(Err) & ": " & Error$ & " on line " & Cstr(Erl)
Resume Next
Exit Sub
End Sub
Feedback response number WEBB86Q5VF created by ~Jennifer Bubkrotherynds on 06/24/2010
Try this Agent
Return to top
. . Try this Agent (~Jennifer Bubkr... 24.Jun.10) 
